home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / Menus / codeWarriorMenu.tcl next >
Text File  |  1996-08-15  |  12KB  |  453 lines
  1. #=== nowrap =====================================================================
  2. #
  3. #             CodeWarrior Interaction
  4. #
  5. # Metrowerks currently has an incomplete appleevent interface. 
  6. # Apple events can be used to direct CodeWarrior to compile
  7. # or add individual files, make the project, etc. However, 
  8. # there is currently no provision to report specific errors
  9. # back to the controller.
  10. #
  11. #================================================================================
  12.  
  13. if {$startingUp} {
  14.     set cwdebugMenu        "･274"
  15.     set cwarriorMenu    "･268"
  16.     addMenu cwarriorMenu
  17.     return
  18. }
  19.  
  20.  
  21. proc cwarriorMenu {} {}
  22.  
  23.  
  24. # called after files saved
  25. lappend savePostHooks codeWarrior_modified
  26.  
  27.  
  28. menu -n "$cwarriorMenu" -p codeWarriorProc {
  29.     "help"
  30.     "/-<UswitchTo"
  31.     {menu -n werksFlags -p werksProc {
  32.         "debugger"
  33.         "switchWhenCompiling"
  34.     }}
  35.     "createFileset"
  36.     "palette"
  37.     "(-"
  38.     "addFile"
  39.     "/K<Ucompile"
  40.     "compileFiles"
  41.     "checkSyntax"
  42.     "precompileﾉ"
  43.     "(-"
  44.     "openHeader"
  45.     "(-"
  46.     "/U<Uupdate"
  47.     "/M<Umake"
  48.     "(-"
  49.     "/D<UgotoDebugger"
  50.     "/B<UsetBreakpoint"
  51.     "clearBreakpoint"
  52.     "/J<UshowSource"
  53.     "(-"
  54.     "/N<UnextError"
  55.     "/R<Urun"
  56. }
  57.  
  58. if {![info exists cwdebugger]}     {set cwdebugger     0}
  59. if {![info exists cwswitchWhenCompiling]}     {set cwswitchWhenCompiling 1}
  60. markMenuItem werksFlags debugger $cwdebugger
  61. markMenuItem werksFlags switchWhenCompiling $cwswitchWhenCompiling
  62.  
  63. proc cwhelp {} {
  64.     global HOME
  65.     edit -r "$HOME:Help:CodeWarrior"
  66. }
  67.     
  68. proc werksProc {menu item} {
  69.     global cw$item modifiedVars
  70.     
  71.     set cw$item [expr -1 * ([set cw$item] - 1)]
  72.     markMenuItem werksFlags $item [set cw$item]
  73.     lappend modifiedVars cw$item
  74. }
  75.  
  76.  
  77.  
  78. set CWCLASS        MMPR
  79. set CDCLASS        MWDB
  80.  
  81.  
  82. proc cwnextError {} {
  83.     nextMatch "*Compiler Errors*"
  84. }
  85.  
  86. proc dispErr {{win "* Compiler Errors *"}} {
  87.     if {[string length $win]} {
  88.         set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
  89.         if {[regexp {(Line.*)ｰ} $text dummy sub]} {
  90.             message "$sub"
  91.         }
  92.     }
  93. }
  94.         
  95.  
  96. proc codeWarriorProc {menu item} {
  97.     cw$item
  98. }
  99.     
  100. proc cwpalette {} {
  101.     global cwarriorMenu
  102.     
  103.     float -m $cwarriorMenu -M -1 -n CodeWarrior
  104. }
  105.  
  106. proc cwswitchTo {} {
  107.     global CODEWarrior
  108.     checkCw
  109.     switchTo $CODEWarrior
  110. }
  111.  
  112. proc cwmake {} {killCwErrors; cwDo Make}
  113. proc cwupdate {} {cwDo UpdP}
  114.  
  115. proc cwDo {param} {
  116.     global CODEWarrior CWCLASS ALPHA
  117.     checkCw
  118.     switchTo $CODEWarrior
  119.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS $param "Errs" "bool(ﾇ01ﾈ)"]]]} {
  120.         warriorErrors $res
  121.     }
  122. }
  123.  
  124. proc cwrun {} {
  125.     global CODEWarrior CWCLASS ALPHA cwdebugger
  126.     checkCw
  127.     killCwErrors
  128.     set bug $cwdebugger
  129.     switchTo $CODEWarrior
  130.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS RunP "Errs" "bool(ﾇ01ﾈ)" DeBg $bug]]]} {
  131.         warriorErrors $res
  132.     }
  133. }
  134.  
  135.  
  136. proc cwprecompile {} {
  137.     global CODEWarrior CWCLASS res
  138.     checkCw
  139.     set fname [car [winNames -f]]
  140.     set targ [putfile "Precompile target:"]
  141.     switchTo $CODEWarrior
  142.     if {[string length [set res [AEBuild $CODEWarrior $CWCLASS PreC "----" [makeAlis $fname] "Errs" "bool(ﾇ01ﾈ)" Targ [makeAlis $targ]]]] > 40} {
  143.         warriorErrors $res
  144.     } else {
  145.         if {[regexp {errn:([-0-9]+)} $res dummy errno]}  {
  146.             message "Error number: $errno"
  147.         }
  148.     }
  149. }
  150.  
  151.  
  152. proc cwaddFile {} {
  153.     global CODEWarrior CWCLASS
  154.     checkCw
  155.     switchTo $CODEWarrior
  156.     set fname [car [winNames -f]]
  157.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS AddF "----" [makeAlis $fname]]
  158. }
  159.  
  160. proc cwcheckSyntax {} {
  161.     global CODEWarrior CWCLASS res
  162.     checkCw
  163. #    switchTo $CODEWarrior
  164.     set fname [car [winNames -f]]
  165.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Chek "----" [concat {[alis(ﾇ} [coerce TEXT $fname -x alis] {ﾈ)]}] "Errs" "bool(ﾇ01ﾈ)"]]] > 40} {
  166.         warriorErrors $res
  167.     }
  168. }
  169.  
  170.  
  171. proc killCwErrors {} {
  172.     set wins [winNames]
  173.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  174.         set name [lindex $wins $res]
  175.         bringToFront $name
  176.         killWindow
  177.     }
  178. }    
  179.  
  180.  
  181. proc cwcompile {} {
  182.     global CODEWarrior CWCLASS res ALPHA cwswitchWhenCompiling
  183.     save
  184.     checkCw
  185.     set fname [car [winNames -f]]
  186.     killCwErrors
  187.     if {$cwswitchWhenCompiling} {
  188.         switchTo $CODEWarrior
  189.     }
  190.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlis $fname] "Errs" "bool(ﾇ01ﾈ)"]]] > 40} {
  191.         warriorErrors $res
  192.     }
  193.     switchTo $ALPHA
  194. }
  195.  
  196.  
  197. proc cwcompileFiles {} {
  198.     global CODEWarrior CWCLASS res ALPHA winModes
  199.     saveAll
  200.     checkCw
  201.     set files {}
  202.     set wins [winNames -f]
  203.     set md $winModes([lindex $wins 0])
  204.     foreach w $wins {
  205.         if {$md == $winModes($w)} {
  206.             lappend files $w
  207.         }
  208.     }
  209.     killCwErrors
  210.     switchTo $CODEWarrior
  211.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [eval makeAlises $files] "Errs" "bool(ﾇ01ﾈ)"]]] > 40} {
  212.         warriorErrors $res
  213.     }
  214.     switchTo $ALPHA
  215. }
  216.  
  217.  
  218. proc cwGetFiles {} {
  219.     global CODEWarrior CWCLASS
  220.     checkCw
  221.     set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GSeg]
  222.     regexp {¥[(.*)¥]} $res dummy segs
  223.     regsub -all {, Seg} $segs {･} segs
  224.     set ind 1
  225.     foreach seg [split $segs {･}] {
  226.         regexp {NumF:([0-9]+)} $seg dummy num
  227.         
  228.         while {$num > 0} {
  229.             set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GFil "----" "long($num)" Segm "long($ind)"]
  230.             if {[regexp {FTxt} $res]} {
  231.                 regexp {ﾇ(.*)ﾈ} $res dummy spec
  232.                 set f [specToPathName $spec]
  233.                 message $f
  234.                 lappend files $f
  235.             }
  236.             incr num -1
  237.         }
  238.         incr ind
  239.     }
  240.     return $files
  241. }
  242.  
  243. proc cwcreateFileset {} {
  244.     createWarriorFileset
  245.     rebuildAllFilesets
  246. }
  247.  
  248.  
  249. proc createWarriorFileset {} {
  250.     global gfileSets gfileSetsType
  251.     
  252.     set name [prompt "Fileset name? " "CodeWarrior"]
  253.     set gfileSets($name) [lsort -command sortByTail [cwGetFiles]]
  254.     set gfileSetsType($name) codewarrior
  255.     addArrDef gfileSetsType $name codewarrior
  256.  
  257.     if {[askyesno "Save project fileset?"] == "yes"} {
  258.         addArrDef gfileSets $name  $gfileSets($name)
  259.     }
  260.     return $name
  261. }
  262.  
  263.  
  264. # the error reply from CodeWarrior looks like this
  265. # [ErrM{ErrT:ErCW, ErrS:ﾒfunction declaration hides inherited virtual functionﾓ, file:fss (ﾇFFFB000014371443536D617274537464506F7075704D656E752E6800000000000000000000000000000000000000000000000000000000000000000000000000000000000000ﾈ), ErrL:64}, ...]
  266. #
  267. # ErrT is the error type parameter
  268. #     ErCW indicates a warning
  269. #     ErCE indicates an error
  270. # Improvements by jdunning@cs.Princeton.EDU (John Dunning)
  271. proc warriorErrors {res} {    
  272.     global winModes tileLeft tileTop tileWidth errorHeight
  273.  
  274.     if {[regexp {¥[.*¥]} $res res]} {
  275.             # trim off the outside brackets
  276.         set res [string trim $res {[]}]
  277.         
  278.             # replace all the returns in the error list with spaces.  this is 
  279.             # necessary because CW 7.0 can return multi-line error messages,
  280.             # which aren't processed correctly by this function.
  281.         regsub -all "¥r" $res " " res
  282.         
  283.             # delete the first ErrM, and replace the remaining ones (and the preceeding commas)
  284.             # with returns
  285.         regsub {ErrM} $res "" res
  286.         regsub -all {, ErrM} $res "¥r" res
  287.         
  288.         set text ""
  289.         set errors 0
  290.         set warnings 0
  291.         set messages 0
  292.         set link 0
  293.         
  294.             # split the string into separate lines, one error per line.  only process
  295.             # process the first 101 errors
  296.         foreach err [lrange [split $res "¥r"] 0 100] {
  297.                 # the last two letters in ErrT:Er.. signal whether it's a compile (C) or link (L)
  298.                 # error and whether it's an error (E) or a warning (W).  stick the rest of
  299.                 # the error message back into err.
  300.             if {[regexp {ErrT:Er(.)(.),[ ¥t]*(.*)} $err unused compileOrLink errorOrWarning err]} {
  301.                 if {$errorOrWarning == "E"} {
  302.                         # mark actual errors with a bullet
  303.                     append text " ･ "
  304.                     incr errors
  305.                 } else {
  306.                         # mark warnings with a delta
  307.                     append text " ﾆ "
  308.                     incr warnings
  309.                 }
  310.                 
  311.                 if {$compileOrLink == "C"} {
  312.                         # we have a compile error, so strip out the error message, the filespec
  313.                         # and the line number
  314.                     if {[regexp {ErrS:ﾒ(.*)ﾓ.*ﾇ(.*)ﾈ.*ErrL:([0-9]+)} $err unused errorString fileSpec lineNumber]} {
  315.                             # conver the filespec that was returned in the apple event into a pathname
  316.                             # so we can display it
  317.                         set pathName [specToPathName $fileSpec]
  318.                     
  319.                             # append the file name (the tail of the pathname), the line number,
  320.                             # the error string, lots of tabs, and then the full pathname
  321.                         append text "¥"[file tail $pathName]¥"¥t; Line $lineNumber: $errorString¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tｰ$pathName¥r"
  322.                     }
  323.                 } else {
  324.                         # we got a link error
  325.                     set link 1
  326.                     
  327.                         # just strip out the error message.  the file the error occurs in doesn't 
  328.                         # seem to get included in the event
  329.                     if {[regexp {ErrS:ﾒ(.*)ﾓ} $err unused errorString]} {
  330.                             # append the error message
  331.                         append text "$errorString¥r"
  332.                     }
  333.                 }
  334.             } elseif {[regexp {ﾒ([^:]*): (.*)ﾓ} $err unused fileName message]} {
  335.                     # we got some sort of message, so strip out the associated file name and 
  336.                     # the message.  I'm not sure if CodeWarrior still returns anything of this form.
  337.                 append text "¥"$fileName¥" ; $message¥r"
  338.                 incr messages
  339.             }
  340.         }
  341.  
  342.         set wins [winNames]
  343.         if {$errors == 0 && $warnings == 0 && $messages == 0} {
  344.             global killCompilerErrors
  345.             set killCompilerErrors 1
  346.             return
  347.         }
  348.         
  349.         new -n {* Compiler Errors *} -g $tileLeft $tileTop $tileWidth $errorHeight
  350.         changeMode [set winModes([lindex [winNames] 0]) Brws]
  351.  
  352.         if {$link} {
  353.             insertText "(Link: $errors errors, $warnings warnings, $messages messages)¥r-----¥r$text"
  354.         } else {
  355.             insertText "($errors errors, $warnings warnings, $messages messages: <cr> to go to line)¥r-----¥r$text"
  356.         }
  357.  
  358.         display 0
  359.         goto 0
  360.         downBrowse
  361.         setWinInfo dirty 0
  362.         setWinInfo read-only 1
  363.         gotoMatch
  364.     }
  365. }
  366.  
  367.  
  368.  
  369. proc codeWarrior_modified fname { 
  370.     global CWCompSig CWCLASS mode
  371.     
  372.     if {($mode == "C") || ($mode == "C++")} {
  373.         foreach p [processes] {
  374.             if {[lindex $p 1] == $CWCompSig} {
  375.                 set res [AEBuild -t 500000 [lindex $p 0] $CWCLASS "Toch" "----" [makeAlis $fname]]
  376.                 return
  377.             }
  378.         }
  379.     }
  380. }
  381.  
  382.  
  383. proc cwTouch {} {
  384.     global CODEWarrior CWCLASS
  385.     checkCw
  386.     switchTo $CODEWarrior
  387.     set fname [car [winNames -f]]
  388.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]]
  389. }
  390.     
  391. proc checkCw {} {
  392.     global CODEWarrior modifiedVars CWCompSig 
  393.     if {![info exists CWCompSig]} {set CWCompSig CWIE}
  394.     
  395.     if {[catch {launchBackApplSigs {CWIE MMCC MPCC} CWCompSig} name]} {
  396.         getApplSig "Please locate CodeWarrior compiler" CWCompSig
  397.     }
  398.     set CODEWarrior [file tail [launchBackAppl $CWCompSig]]
  399. }
  400.  
  401. proc checkCwDebug {} {
  402.     global CODEDEBUGGER CWDbgSig modifiedVars
  403.     if {[catch {launchBackApplSigs {MPDB MWDB} CWDbgSig} name]} {
  404.         getApplSig "Please locate CodeWarrior debugger" CWDbgSig
  405.     }
  406.     set CODEDEBUGGER [file tail [launchBackAppl $CWDbgSig]]
  407. }
  408.  
  409. proc cwgotoDebugger {} {
  410.     global CODEDEBUGGER
  411.     checkCwDebug
  412.     switchTo $CODEDEBUGGER
  413. }
  414.  
  415. proc cwsetBreakpoint {} {
  416.     global CODEDEBUGGER CDCLASS res
  417.     checkCwDebug
  418.     switchTo $CODEDEBUGGER
  419.     set fname [car [winNames -f]]
  420.     set ln [lindex [posToRowCol [getPos]] 0]
  421.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Sbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  422. }
  423.  
  424. proc cwclearBreakpoint {} {
  425.     global CODEDEBUGGER CDCLASS res
  426.     checkCwDebug
  427.     switchTo $CODEDEBUGGER
  428.     set fname [car [winNames -f]]
  429.     set ln [lindex [posToRowCol [getPos]] 0]
  430.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Cbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  431. }
  432.  
  433.  
  434. proc cwshowSource {} {
  435.     global CODEDEBUGGER CDCLASS res
  436.     checkCwDebug
  437.     switchTo $CODEDEBUGGER
  438.     set fname [car [winNames -f]]
  439.     set ln [lindex [posToRowCol [getPos]] 0]
  440.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Show" "----" [makeAlis $fname] "Line" "long($ln)"]
  441. }
  442. #  "Soff" "long([getPos]" "Eoff" "long([selEnd])"
  443.  
  444. proc cwopenHeader {} {
  445.     if {[regexp {#include.*("|<)(.*)("|>)} [getText [lineStart [getPos]] [nextLineStart [getPos]]] d1 d1 inc]} {
  446.         return [cIncludeFile $inc]
  447.     }
  448.     message "No include file found on this line!"
  449.     beep
  450. }
  451.  
  452.  
  453.